Programming Languages Suite

home *** CD-ROM | disk | FTP | other *** search

/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / CLISRV / BOOKSALE / CLIENT / BOOK_CLI.FRM (.txt) < prev next >

Wrap

Visual Basic Form | 1996-12-06 | 20.2 KB | 590 lines

VERSION 5.00 Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.1#0"; "comctl32.ocx" Object = "{FE0065C0-1B7B-11CF-9D53-00AA003C9CB6}#1.0#0"; "ComCt232.Ocx" Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "ComDlg32.OCX" Begin VB.Form frmRevenue Caption = "Book Revenue" ClientHeight = 5895 ClientLeft = 2505 ClientTop = 2415 ClientWidth = 6840 ClipControls = 0 'False BeginProperty Font Name = "Tahoma" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Icon = "BOOK_CLI.frx":0000 LinkTopic = "Form1" PaletteMode = 1 'UseZOrder ScaleHeight = 5895 ScaleWidth = 6840 WhatsThisHelp = -1 'True Begin VB.Frame Frame1 Caption = "Revenue Parameters" Height = 2685 Left = 80 TabIndex = 4 Top = 2250 Width = 6660 Begin VB.CheckBox chkDiscount Caption = "Promotional Discount" Height = 270 Left = 4080 TabIndex = 8 Top = 960 Width = 1815 End Begin VB.Frame Frame3 BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 1545 Left = 3915 TabIndex = 15 Top = 990 Width = 2595 Begin VB.TextBox txtRevParm Enabled = 0 'False Height = 300 Index = 5 Left = 1755 TabIndex = 10 Text = "3" Top = 690 Width = 375 End Begin VB.TextBox txtRevParm Enabled = 0 'False Height = 300 Index = 4 Left = 1755 TabIndex = 9 Text = "2" Top = 315 Width = 375 End Begin VB.TextBox txtRevParm Enabled = 0 'False Height = 300 Index = 6 Left = 1755 TabIndex = 11 Text = "15" Top = 1080 Width = 375 End Begin ComCtl2.UpDown udDiscount Height = 255 Index = 4 Left = 2280 TabIndex = 32 Top = 360 Width = 150 _ExtentX = 423 _ExtentY = 450 _Version = 327680 Enabled = -1 'True End Begin ComCtl2.UpDown udDiscount Height = 255 Index = 5 Left = 2280 TabIndex = 33 Top = 720 Width = 150 _ExtentX = 423 _ExtentY = 450 _Version = 327680 Enabled = -1 'True End Begin ComCtl2.UpDown udDiscount Height = 255 Index = 6 Left = 2280 TabIndex = 34 Top = 1080 Width = 150 _ExtentX = 423 _ExtentY = 450 _Version = 327680 Enabled = -1 'True End Begin VB.Label Label2 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Duration (months):" Enabled = 0 'False Height = 195 Index = 5 Left = 150 TabIndex = 25 Top = 720 Width = 1485 End Begin VB.Label Label2 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Start Month:" Enabled = 0 'False Height = 195 Index = 4 Left = 480 TabIndex = 24 Top = 360 Width = 1155 End Begin VB.Label Label2 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Discount %:" Enabled = 0 'False Height = 195 Index = 6 Left = 555 TabIndex = 23 Top = 1080 Width = 1080 End End Begin VB.CommandButton cmdCogs Caption = "..." Height = 330 Left = 3720 TabIndex = 3 Top = 390 Width = 315 End Begin VB.TextBox txtRevParm Height = 300 Index = 3 Left = 2445 TabIndex = 7 Text = "5000" Top = 2145 Width = 1215 End Begin VB.TextBox txtRevParm Height = 300 Index = 2 Left = 2445 TabIndex = 6 Text = "12" Top = 1590 Width = 1215 End Begin VB.TextBox txtRevParm Height = 300 Index = 1 Left = 2445 TabIndex = 5 Text = "10000" Top = 1020 Width = 1215 End Begin VB.TextBox txtRevParm Height = 300 Index = 0 Left = 1440 TabIndex = 16 TabStop = 0 'False Top = 405 Width = 2160 End Begin VB.TextBox txtRevParm BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 300 Index = 7 Left = 4215 TabIndex = 28 TabStop = 0 'False Top = 1245 Width = 405 End Begin VB.Label Label2 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Units/Month :" Height = 195 Index = 3 Left = 270 TabIndex = 22 Top = 2190 Width = 1815 End Begin VB.Label Label2 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Period (months):" Height = 195 Index = 2 Left = 285 TabIndex = 21 Top = 1620 Width = 1800 End Begin VB.Label Label2 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Advertising Cost:" Height = 195 Index = 1 Left = 240 TabIndex = 20 Top = 1050 Width = 1845 End Begin VB.Label Label2 Alignment = 1 'Right Justify AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "COGS Code:" Height = 195 Index = 0 Left = 330 TabIndex = 19 Top = 450 Width = 1005 End Begin VB.Label Label2 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Author Royalty:" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Index = 7 Left = 4320 TabIndex = 27 Top = 1350 Width = 1080 End End Begin VB.Frame frmSalesModel Caption = "Sales Model" Height = 1350 Left = 80 TabIndex = 2 Top = 765 Width = 6660 Begin VB.OptionButton optAnalysis Height = 975 Index = 2 Left = 4920 Picture = "BOOK_CLI.frx":030A Style = 1 'Graphical TabIndex = 29 Top = 240 Width = 1575 End Begin VB.OptionButton optAnalysis Height = 975 Index = 1 Left = 2580 Picture = "BOOK_CLI.frx":166C Style = 1 'Graphical TabIndex = 30 Top = 240 Width = 1575 End Begin VB.OptionButton optAnalysis Height = 975 Index = 0 Left = 240 Picture = "BOOK_CLI.frx":29CE Style = 1 'Graphical TabIndex = 31 Top = 240 Width = 1575 End End Begin VB.CommandButton cmdClose Caption = "&Close" Height = 420 Left = 5520 TabIndex = 14 Top = 5025 Width = 1215 End Begin VB.CommandButton cmdHelp Caption = "&Help" Height = 420 Left = 120 TabIndex = 13 Top = 5040 Width = 1215 End Begin VB.CommandButton cmdExecute Caption = "Execute..." Default = -1 'True Height = 420 Left = 4080 TabIndex = 12 Top = 5040 Width = 1215 End Begin VB.ComboBox cboBooks Height = 315 Left = 2160 Sorted = -1 'True TabIndex = 1 Top = 360 Width = 4620 End Begin VB.ComboBox cboAuthors Height = 315 Left = 80 Sorted = -1 'True TabIndex = 0 Top = 360 Width = 1980 End Begin ComctlLib.StatusBar StatusBar1 Align = 2 'Align Bottom Height = 315 Left = 0 TabIndex = 26 Top = 5580 Width = 6840 _ExtentX = 12065 _ExtentY = 556 Style = 1 SimpleText = "" _Version = 327680 BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7} NumPanels = 1 BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7} TextSave = "" Object.Tag = "" EndProperty EndProperty BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "Tahoma" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty End Begin MSComDlg.CommonDialog CommonDialog1 Left = 6600 Top = 5520 _ExtentX = 847 _ExtentY = 847 _Version = 327680 FontSize = 1.73861e-39 End Begin VB.Label Label1 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Books:" Height = 195 Index = 1 Left = 2160 TabIndex = 18 Top = 135 Width = 480 End Begin VB.Label Label1 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Author:" Height = 195 Index = 0 Left = 90 TabIndex = 17 Top = 135 Width = 555 End Attribute VB_Name = "frmRevenue" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim sSQL As String Private Sub cboAuthors_Click() GetTitles cboAuthors.Text End Sub Sub GetAuthors() Dim strSQL As String Dim objAuthorField As Object On Error GoTo GetAuthorsError strSQL = "SELECT Authors.Author " & _ "FROM Authors" Set gSn = gDB.OpenRecordset(strSQL, dbOpenSnapshot, dbForwardOnly) Set objAuthorField = gSn.Fields("author") Do While Not gSn.EOF cboAuthors.AddItem objAuthorField gSn.MoveNext Loop gSn.Close cboAuthors.ListIndex = 0 Exit Sub GetAuthorsError: If IsObject(gSn) Then gSn.Close Exit Sub End Sub Sub GetTitles(strAuthor As String) Dim strSQL As String Dim objTitlesField As Object On Error GoTo GetTitlesError strSQL = "SELECT Titles.Title " & _ "FROM Titles INNER JOIN (Authors INNER JOIN [Title Author] ON Authors.Au_ID = [Title Author].Au_ID) ON Titles.ISBN = [Title Author].ISBN " & _ "WHERE ((Authors.Author=" & Chr$(34) & strAuthor & Chr$(34) & "));" Set gSn = gDB.OpenRecordset(strSQL, dbOpenSnapshot, dbForwardOnly) cboBooks.Clear Set objTitlesField = gSn.Fields("Title") Do While Not gSn.EOF cboBooks.AddItem objTitlesField gSn.MoveNext gSn.Close cboBooks.ListIndex = 0 Exit Sub GetTitlesError: If Not gSn Is Nothing Then gSn.Close Exit Sub End Sub Private Sub chkDiscount_Click() Label2(4).Enabled = Not Label2(4).Enabled Label2(5).Enabled = Not Label2(5).Enabled Label2(6).Enabled = Not Label2(6).Enabled txtRevParm(4).Enabled = Not txtRevParm(4).Enabled txtRevParm(5).Enabled = Not txtRevParm(5).Enabled txtRevParm(6).Enabled = Not txtRevParm(6).Enabled udDiscount(4).Enabled = Not udDiscount(4).Enabled udDiscount(5).Enabled = Not udDiscount(5).Enabled udDiscount(6).Enabled = Not udDiscount(6).Enabled End Sub Private Sub cmdClose_Click() Unload Me End Sub Private Sub cmdCogs_Click() goStatusPanel.Text = "Determining Cost of Goods." Load frmCogs goStatusPanel.Text = "" End Sub Private Sub cmdHelp_Click() Dim sHelpString As String sHelpString = "1. Select an author and a book title." & vbCrLf & _ "2. Select a Sales Model." & vbCrLf & _ "3. Click the Select button to set the COGS price." & vbCrLf & _ "4. Enter an amount to spend on Advertising Costs." & vbCrLf & _ "5. Enter number of months in the Sales Period." & vbCrLf & _ "6. Enter number of units sold per month." & vbCrLf & _ "7. Optionally, click the Promotional Discount box to" & vbCrLf & _ " add a sales promotion for this book." & vbCrLf & _ "8. Click the Show Chart button to display a chart of" & vbCrLf & _ " Publisher revenue and Author royalties." MsgBox sHelpString, vbInformation, "Book Revenue Help" End Sub Private Sub cmdExecute_Click() If cboBooks.Text = "<None>" Or cboBooks.Text = "" Then MsgBox "Can not create a chart when there is no book title available.", _ vbExclamation, "Create Chart Error" Exit Sub End If goStatusPanel.Text = "Creating chart..." Load frmChart frmChart.Show End Sub Private Sub Form_Load() Screen.MousePointer = vbHourglass Me.Show On Error GoTo LoadError Set goStatusPanel = StatusBar1.Panels.Item(1) Set gDB = Workspaces(0).OpenDatabase(gstrDBName, False, True) goStatusPanel.Text = "Retrieving Authors Listing..." GetAuthors goStatusPanel.Text = "Connecting to remote rule..." Set goBookSaleSvrInst = CreateObject("BookSaleSvr.Sales") goStatusPanel.Text = "Remote Connection Successful..." LoadExit: Screen.MousePointer = vbDefault Exit Sub LoadError: 'advanced error handling is required if the database cannot be 'found as error 3024 would indicate. If Err = 3024 Then 'set CommonDialog properties before showing With CommonDialog1 .DialogTitle = "Unable to find the booksale.mdb file location" .Filter = "(*.mdb)|*.mdb" .InitDir = CurDir .filename = "" .Flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNPathMustExist .ShowOpen 'make sure the filename is not an empty string If .filename <> "" Then 'make sure that the database file returned is indeed biblio.mdb If Right(UCase(.filename), Len("booksale.mdb")) = "BOOKSALE.MDB" Then gstrDBName = .filename End If Resume Else Unload Me End If End With ElseIf Err <> 0 Then ' another error MsgBox Error$ & " - " & Str$(Err), vbExclamation, "Form_Load Error" End End If Resume LoadExit End Sub Private Sub Form_Unload(Cancel As Integer) Set gSn = Nothing Set goBookSaleSvrInst = Nothing End Sub Private Sub optAnalysis_Click(Index As Integer) frmSalesModel.Tag = Index End Sub Private Sub txtRevParm_GotFocus(Index As Integer) txtRevParm(Index).SelStart = 0 txtRevParm(Index).SelLength = Len(txtRevParm(Index).Text) End Sub Private Sub udDiscount_DownClick(Index As Integer) If Val(txtRevParm(Index).Text) > 1 Then txtRevParm(Index).Text = Val(txtRevParm(Index).Text) - 1 End If End Sub Private Sub udDiscount_UpClick(Index As Integer) If Val(txtRevParm(Index).Text) < 99 Then txtRevParm(Index).Text = Val(txtRevParm(Index).Text) + 1 End If End Sub